#! /usr/bin/perl -w
# $Id: statpic.cgi,v 1.1.1.1 2004/02/21 18:48:07 ibo Exp $
# Make diagrams from data

use strict;
#use lib '/users/p6ip02/p6ip2/p6mip386/prgs/perl-lib';
use GD;
use CGI;

sub init ();                    # autosense CGI mode
sub initpie ();                 # setup computed values, draw the 1st line
sub drawslice ($$);             # draw and fill a pie slice
sub drawimg ();                 # parse args and draw accordingly
sub drawpieaa (@);              # antialiased pie
sub drawpie (@);                # pie
sub drawbar ($;$$);             # color bar
sub printimg ();                # print with HTTP headers if needed


sub main () {
    init();
    drawimg();
    printimg();
}

my $pic;
my $setup = {center   => undef,         radius      => undef,
             iscgi    => undef,         isaa        => 0,
             basedims => [320, 240],    dims        => undef,
             aafactor => 4,             drawnpoints => [],
             colors   => [0xffffff, 0x000000] }; # bg color, line color

# rgb, cmy, light rgb, light cmy
my @colors = (0xff0000, 0x00ff00, 0x0000ff,
              0x00ffff, 0xff00ff, 0xffff00,
              0xffbfbf, 0xbfffbf, 0xbfbfff,
              0xbfffff, 0xffbfff, 0xffffbf,);

sub init () {
    my $iscgi = $setup->{iscgi} = CGI::server_software() ne 'cmdline';
    die "Too few arguments" if (!$iscgi && @ARGV<1);
}

sub initpie () {
    $setup->{dims} = $setup->{basedims};
    if ($setup->{isaa}) {
        my ($w, $h, $aafactor) = (@{$setup->{basedims}}, $setup->{aafactor});
        $setup->{dims} = [$w * $aafactor, $h * $aafactor];
    }
    my ($w, $h) = @{$setup->{dims}};

    $pic = GD::Image->newTrueColor(@{$setup->{dims}})
      || die "Couldn't create a new GD::Image";
    $pic->interlaced(1);

    # make the picture's background transparent
    $pic->transparent($setup->{colors}[0]);

    # center of the pie = center of the picture
    $setup->{center} = [$w/2, $h/2];

    # radius = max fitting * reduction factor
    $setup->{radius} = ($w<$h ? $w : $h) / 2;
    $setup->{radius} *= 0.95;

    # fill the whole image with the BG color
    $pic->filledRectangle(0, 0, @{$setup->{dims}}, $setup->{colors}[0]);

    my ($cx, $cy, $two_r) = (@{$setup->{center}}, $setup->{radius}*2);
    $pic->arc($cx, $cy, $two_r, $two_r, 0, 360, $setup->{colors}[1]);
    drawslice(0, -1)
}

sub drawslice ($$) {
    my ($pcent, $color) = @_;
    my $angle = -$pcent * 8 * atan2 1, 1; # angle = -pcent*2*pi
    my ($x0, $y0, $r) = (@{$setup->{center}}, $setup->{radius});
    my ($x1, $y1) = ($r*cos($angle), $r*sin($angle));

    push @{$setup->{drawnpoints}}, [$x0+$x1, $y0+$y1];
    if ($pcent >= 1) {          # last slice: fill only, no line
        my @args = ($x0+$r/2, $y0+1, $setup->{colors}[1], $color);
        $pic->fillToBorder(@args);
    } else {
        if ($color >= 0) {
            $pic->fillToBorder($x1/2 + $x0, $y1/2 + $y0, 
                               $setup->{colors}[1], $color);
        }
        $pic->line($x0, $y0, $x0+$x1, $y0+$y1, $setup->{colors}[1]);
    }
}

sub drawimg () {
    my($fnc, $data, $ext, $values, @data);

    # turn the data string into an array
    if ($setup->{iscgi}) {
        $values = CGI::path_info()
          || die "No path_info received";
    } else {
        $values = $ARGV[0];
    }

    # match something like '/bar57_21_32.png' or 'bar57+21+32.png'
    # the separator "sep" is [_+ ]
    if ($values =~ /^
                    \/*            # any number of leading slashes
                    ([a-z]+)       # some lowercase letters        "bar"
                    (\d[\d_+ ]+\d) # "sep"-separated numbers       "57+21+32"
                    \.             # a dot
                    (?:[a-z]+)     # a lowercase extension         "png"
                    $/x) {

        ($fnc, $data, $ext) = ($1, $2, $3);
        $values=$2;
    } else {
        die "Bad argument value";
    }

    @data = split /[\s+_]+/, $values;
    @data || die "No data received";

    # switch execution to the appropriate function
    my %funcs = (pie => \&drawpie, pieaa => \&drawpieaa,
                 bar => \&drawbar);

    if (defined (my $func = $funcs{$fnc})) {
        &$func(@data)
    } else {
        die sprintf "Unknown graph type '%s'", $fnc;
    }
}

sub drawpieaa (@) {
    $setup->{isaa} = 1;
    &drawpie;                   # call with the same @_
}

sub drawpie (@) {
    my @data = @_;
    initpie();

    # turn e.g. 1 2 3 into .16 .50 1
    my ($sum, $tot) = (0, 0);
    foreach (@data) { $sum += $_; }
    foreach (@data) { $_ /= $sum; }
    foreach (@data) { $_ = $tot += $_; }
    $data[-1] = 1;              # in case there were rounding errors

    # draw the slices
    for (my $i=0; $i<@data; ++$i) {
        drawslice($data[$i], $colors[$i%@colors]);
    }

    if ($setup->{isaa}) {
        my ($bw, $bh, $w, $h) = (@{$setup->{basedims}}, @{$setup->{dims}});

        my ($x0, $y0, $r) = (@{$setup->{center}}, $setup->{radius});
        my $brush = GD::Image->newTrueColor($setup->{aafactor}*2,
                                            $setup->{aafactor}*2);
        $brush->fill(0, 0, $setup->{colors}[1]);

        $pic->setBrush($brush);
        $pic->arc($x0, $y0, $r*2, $r*2, 0, 360, GD::gdBrushed);
        foreach my $point (@{$setup->{drawnpoints}}) {
            $pic->line($x0, $y0, @$point, gdBrushed);
        }

        # zoom out
        my $smallpic = GD::Image->newTrueColor($bw, $bh);
        $smallpic->transparent($setup->{colors}[0]);
        $smallpic->copyResampled($pic, 0, 0, 0, 0, $bw, $bh, $w, $h);
        $pic = $smallpic
    }
}

sub drawbar ($;$$) {
    my ($index, $sx, $sy) = @_;
    $sx ||= 32, $sy ||= $sx/2;
    $pic = GD::Image->newTrueColor($sx, $sy);
    $pic->fill(0, 0, $colors[$index%@colors]);
    $pic->rectangle(0, 0, $sx-1, $sy-1, 0);
}

sub printimg () {
    if ($setup->{iscgi}) {
        print CGI::header({-content_type => 'image/png',
                           -expires => '+1d',});
    }
    binmode STDOUT;
    print $pic->png();
}

main;
